home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPT.Mod (.txt) < prev    next >
Oberon Text  |  1994-07-11  |  35KB  |  859 lines
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Courier10.Scn.Fnt
  5. MODULE POPT;    (* NW, RC 6.3.89 / 9.2.94 *)
  6.     IMPORT
  7.         OPS := POPS, OPM := POPM;
  8.     CONST
  9.         MaxConstLen* = OPS.MaxStrLen;
  10.     TYPE
  11.         Const* = POINTER TO ConstDesc;
  12.         Object* = POINTER TO ObjDesc;
  13.         Struct* = POINTER TO StrDesc;
  14.         Node* = POINTER TO NodeDesc;
  15.         ConstExt* = POINTER TO OPS.String;
  16.         ConstDesc* = RECORD
  17.             ext*: ConstExt;    (* string or code for code proc *)
  18.             intval*: LONGINT;    (* constant value or adr, proc par size, text position or least case label *)
  19.             intval2*: LONGINT;    (* string length, proc var size or larger case label *)
  20.             setval*: SET;    (* constant value, procedure body present or "ELSE" present in case *)
  21.             realval*: LONGREAL    (* real or longreal constant value *)
  22.         END ;
  23.         ObjDesc* = RECORD
  24.             left*, right*, link*, scope*: Object;
  25.             name*: OPS.Name;
  26.             leaf*: BOOLEAN;
  27.             mode*, mnolev*: SHORTINT;    (* mnolev < 0 -> mno = -mnolev *)
  28.             vis*: SHORTINT;    (* 0: internal; 1: external; 2: externalR *)
  29.             typ*: Struct;
  30.             conval*: Const;
  31.             adr*, linkadr*: LONGINT
  32.         END ;
  33.         StrDesc* = RECORD
  34.             form*, comp*, mno*, extlev*: SHORTINT;
  35.             ref*, sysflag*: INTEGER;
  36.             n*, size*, tdadr*, offset*, txtpos*: LONGINT;
  37.             BaseTyp*: Struct;
  38.             link*, strobj*: Object
  39.         END ;
  40.         NodeDesc* = RECORD
  41.             left*, right*, link*: Node;
  42.             class*, subcl*: SHORTINT;
  43.             readonly*: BOOLEAN;
  44.             typ*: Struct;
  45.             obj*: Object;
  46.             conval*: Const
  47.         END ;
  48. (* Objects:
  49.     mode  | adr   conval  link     scope    leaf
  50.     ---------------------------------------------
  51.     Undef |                                        Not used
  52.     Var   | adr           next              regopt Glob or loc var or proc value parameter
  53.     VarPar| vadr          next              regopt Procedure var parameter
  54.     Con   |       val                              Constant
  55.     Fld   | off           next                     Record field
  56.     Typ   |                                        Named type
  57.     LProc |       sizes   firstpar scope    leaf   Local procedure
  58.     XProc | pno   sizes   firstpar scope    leaf   External procedure
  59.     SProc | fno   sizes                            Standard procedure
  60.     CProc |       code    firstpar scope           Code procedure
  61.     IProc | pno   sizes            scope    leaf   Interrupt procedure
  62.     Mod   | key                    scope           Module
  63.     Head  | txtpos        owner    firstvar        Scope anchor
  64.     TProc | index sizes   firstpar scope    leaf   Bound procedure, index = 10000H*mthno+pno
  65.                                                     
  66. Structures:
  67.     form    comp  | n      BaseTyp   link     mno  tdadr  offset txtpos   sysflag
  68.     -----------------------------------------------------------------------------
  69.     Undef   Basic |
  70.     Byte    Basic |
  71.     Bool    Basic |
  72.     Char    Basic |
  73.     SInt    Basic |
  74.     Int     Basic |
  75.     LInt    Basic |
  76.     Real    Basic |
  77.     LReal   Basic |
  78.     Set     Basic |
  79.     String  Basic |
  80.     NilTyp  Basic |
  81.     NoTyp   Basic |
  82.     Pointer Basic |        PBaseTyp           mno                txtpos   sysflag
  83.     ProcTyp Basic |        ResTyp    params   mno                txtpos   sysflag
  84.     Comp    Array | nofel  ElemTyp            mno                txtpos   sysflag
  85.     Comp    DynArr| dim    ElemTyp            mno         lenoff txtpos   sysflag
  86.     Comp    Record| nofmth RBaseTyp  fields   mno  tdadr         txtpos   sysflag
  87. Nodes:
  88. design   = Nvar|Nvarpar|Nfield|Nderef|Nindex|Nguard|Neguard|Ntype|Nproc.
  89. expr     = design|Nconst|Nupto|Nmop|Ndop|Ncall.
  90. nextexpr = NIL|expr.
  91. ifstat   = NIL|Nif.
  92. casestat = Ncaselse.
  93. sglcase  = NIL|Ncasedo.
  94. stat     = NIL|Ninittd|Nenter|Nassign|Ncall|Nifelse|Ncase|Nwhile|Nrepeat|
  95.            Nloop|Nexit|Nreturn|Nwith|Ntrap.
  96.               class     subcl     obj      left      right     link      
  97.               ---------------------------------------------------------
  98. design        Nvar                var                          nextexpr
  99.               Nvarpar             varpar                       nextexpr
  100.               Nfield              field    design              nextexpr
  101.               Nderef                       design              nextexpr
  102.               Nindex                       design    expr      nextexpr
  103.               Nguard                       design              nextexpr (typ = guard type)
  104.               Neguard                      design              nextexpr (typ = guard type)
  105.               Ntype               type                         nextexpr
  106.               Nproc     normal    proc                         nextexpr
  107.                         super     proc                         nextexpr
  108. expr          design
  109.               Nconst              const                                 (val = node^.conval)
  110.               Nupto                        expr      expr      nextexpr 
  111.               Nmop      not                expr                nextexpr
  112.                         minus              expr                nextexpr
  113.                         is        tsttype  expr                nextexpr
  114.                         conv               expr                nextexpr
  115.                         abs                expr                nextexpr
  116.                         cap                expr                nextexpr
  117.                         odd                expr                nextexpr
  118.                         adr                expr                nextexpr SYSTEM.ADR
  119.                         cc                 Nconst              nextexpr SYSTEM.CC
  120.                         val                expr                nextexpr SYSTEM.VAL
  121.               Ndop      times              expr      expr      nextexpr
  122.                         slash              expr      expr      nextexpr
  123.                         div                expr      expr      nextexpr
  124.                         mod                expr      expr      nextexpr
  125.                         and                expr      expr      nextexpr
  126.                         plus               expr      expr      nextexpr
  127.                         minus              expr      expr      nextexpr
  128.                         or                 expr      expr      nextexpr
  129.                         eql                expr      expr      nextexpr
  130.                         neq                expr      expr      nextexpr
  131.                         lss                expr      expr      nextexpr
  132.                         leq                expr      expr      nextexpr
  133.                         grt                expr      expr      nextexpr
  134.                         geq                expr      expr      nextexpr
  135.                         in                 expr      expr      nextexpr
  136.                         ash                expr      expr      nextexpr
  137.                         msk                expr      Nconst    nextexpr
  138.                         len                design    Nconst    nextexpr
  139.                         bit                expr      expr      nextexpr SYSTEM.BIT
  140.                         lsh                expr      expr      nextexpr SYSTEM.LSH
  141.                         rot                expr      expr      nextexpr SYSTEM.ROT
  142.               Ncall               fpar     design    nextexpr  nextexpr
  143. nextexpr      NIL
  144.               expr
  145. ifstat        NIL
  146.               Nif                          expr      stat      ifstat
  147. casestat      Ncaselse                     sglcase   stat            (minmax = node^.conval)
  148. sglcase       NIL
  149.               Ncasedo                      Nconst    stat      sglcase
  150. stat          NIL
  151.               Ninittd                                          stat     (of node^.typ)
  152.               Nenter              proc     stat      stat      stat     (proc=NIL for mod)
  153.               Nassign   assign             design    expr      stat
  154.                         newfn              design              stat
  155.                         incfn              design    expr      stat
  156.                         decfn              design    expr      stat
  157.                         inclfn             design    expr      stat
  158.                         exclfn             design    expr      stat
  159.                         copyfn             design    expr      stat
  160.                         getfn              design    expr      stat     SYSTEM.GET
  161.                         putfn              expr      expr      stat     SYSTEM.PUT
  162.                         getrfn             design    Nconst    stat     SYSTEM.GETREG
  163.                         putrfn             Nconst    expr      stat     SYSTEM.PUTREG
  164.                         sysnewfn           design    expr      stat     SYSTEM.NEW
  165.                         movefn             expr      expr      stat     SYSTEM.MOVE
  166.                                                                         (right^.link = 3rd par)
  167.               Ncall               fpar     design    nextexpr  stat
  168.               Nifelse                      ifstat    stat      stat
  169.               Ncase                        expr      casestat  stat
  170.               Nwhile                       expr      stat      stat
  171.               Nrepeat                      stat      expr      stat
  172.               Nloop                        stat                stat 
  173.               Nexit                                            stat 
  174.               Nreturn             proc     nextexpr            stat     (proc = NIL for mod)
  175.               Nwith                        ifstat    stat      stat
  176.               Ntrap                                  expr      stat
  177.     CONST
  178.         maxImps = 31;    (* must be < 128 *)
  179.         topScope*: Object;
  180.         undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
  181.         realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*: Struct;
  182.         nofGmod*: SHORTINT;    (*nof imports*)
  183.         GlbMod*:  ARRAY maxImps OF Object;    (* GlbMod[i]^.mode = exported module number *)
  184.         SYSimported*: BOOLEAN;
  185.     CONST
  186.         (* object modes *)
  187.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  188.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  189.         (* structure forms *)
  190.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  191.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  192.         Pointer = 13; ProcTyp = 14; Comp = 15;
  193.         (* composite structure forms *)
  194.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  195.         (*function number*)
  196.         assign = 0;
  197.         haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4;
  198.         entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9;
  199.         shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14;
  200.         inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32;
  201.         (*SYSTEM function number*)
  202.         adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23;
  203.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27;
  204.         bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31;
  205.         (* module visibility of objects *)
  206.         internal = 0; external = 1; externalR = 2;
  207.         firstStr = 16;
  208.         maxStruct = OPM.MaxStruct;    (* must be < 256 *)
  209.         maxUndPtr = 64;
  210.         NotYetExp = 0;
  211.         universe, syslink: Object;
  212.         strno, udpinx: INTEGER;
  213.         nofExp: SHORTINT;
  214.         nofhdfld: LONGINT;
  215.         undPtr: ARRAY maxUndPtr OF Struct;
  216.     PROCEDURE Init*;
  217.     BEGIN topScope := universe; strno := 0; udpinx := 0; nofGmod := 0; SYSimported := FALSE
  218.     END Init;
  219.     PROCEDURE Close*;
  220.         VAR i: INTEGER;
  221.     BEGIN i := 0;
  222.         WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END    (* garbage collection *)
  223.     END Close;
  224.     PROCEDURE err(n: INTEGER);
  225.     BEGIN OPM.err(n)
  226.     END err;
  227.     PROCEDURE NewConst*(): Const;
  228.         VAR const: Const;
  229.     BEGIN NEW(const); (*const^.ext := NIL;*) RETURN const
  230.     END NewConst;
  231.     PROCEDURE NewObj*(): Object;
  232.         VAR obj: Object;
  233.     BEGIN NEW(obj); (*obj^.left := NIL; obj^.right := NIL; obj^.link := NIL; obj^.scope := NIL; *)
  234.         (*obj^.typ := NIL; obj^.conval := NIL;*) RETURN obj
  235.     END NewObj;
  236.     PROCEDURE NewStr*(form, comp: SHORTINT): Struct;
  237.         VAR typ: Struct;
  238.     BEGIN NEW(typ); (*typ^.link := NIL; typ^.strobj := NIL;*)
  239.         typ^.form := form; typ^.comp := comp;
  240.         (*typ^.mno := 0; typ^.ref := 0; typ^.sysflag := 0; typ^.extlev := 0; typ^.n := 0;*)
  241.         typ^.tdadr := OPM.TDAdrUndef; typ^.offset := OPM.TDAdrUndef;
  242.         typ^.txtpos := OPM.errpos; typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ
  243.     END NewStr;
  244.     PROCEDURE NewNode*(class: SHORTINT): Node;
  245.         VAR node: Node;
  246.     BEGIN
  247.         NEW(node); node^.class := class; (*node^.left := NIL; node^.right := NIL; node^.link := NIL;*)
  248.         (*node^.typ := NIL; node^.obj := NIL; node^.conval := NIL;*)
  249.         RETURN node
  250.     END NewNode;
  251.     PROCEDURE NewExt*(): ConstExt;
  252.         VAR ext: ConstExt;
  253.     BEGIN NEW(ext); RETURN ext
  254.     END NewExt;
  255.     PROCEDURE FindImport*(mod: Object; VAR res: Object);
  256.         VAR obj: Object;
  257.     BEGIN obj := mod^.scope;
  258.         LOOP
  259.             IF obj = NIL THEN EXIT END ;
  260.             IF OPS.name < obj^.name THEN obj := obj^.left
  261.             ELSIF OPS.name > obj^.name THEN obj := obj^.right
  262.             ELSE (*found*)
  263.                 IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL END ;
  264.                 EXIT
  265.             END
  266.         END ;
  267.         res := obj
  268.     END FindImport;
  269.     PROCEDURE Find*(VAR res: Object);
  270.         VAR obj, head: Object;
  271.     BEGIN head := topScope;
  272.         LOOP obj := head^.right;
  273.             LOOP
  274.                 IF obj = NIL THEN EXIT END ;
  275.                 IF OPS.name < obj^.name THEN obj := obj^.left
  276.                 ELSIF OPS.name > obj^.name THEN obj := obj^.right
  277.                 ELSE (*found*) EXIT
  278.                 END
  279.             END ;
  280.             IF obj # NIL THEN EXIT END ;
  281.             head := head^.left;
  282.             IF head = NIL THEN EXIT END
  283.         END ;
  284.         res := obj
  285.     END Find;
  286.     PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object);
  287.         VAR obj: Object;
  288.     BEGIN 
  289.         WHILE typ # NIL DO obj := typ^.link;
  290.             WHILE obj # NIL DO
  291.                 IF name < obj^.name THEN obj := obj^.left
  292.                 ELSIF name > obj^.name THEN obj := obj^.right
  293.                 ELSE (*found*) res := obj; RETURN
  294.                 END
  295.             END ;
  296.             typ := typ^.BaseTyp
  297.         END ;
  298.         res := NIL
  299.     END FindField;
  300.     PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object);
  301.         VAR ob0, ob1: Object; left: BOOLEAN;
  302.     BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE;
  303.         LOOP
  304.             IF ob1 # NIL THEN
  305.                 IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE
  306.                 ELSIF name > ob1^.name THEN ob0 := ob1; ob1 := ob0^.right; left := FALSE
  307.                 ELSE (*double def*) err(1); ob0 := ob1; ob1 := ob0^.right
  308.                 END
  309.             ELSE (*insert*) ob1 := NewObj(); ob1^.leaf := TRUE;
  310.                 IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
  311.                 ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name);
  312.                 ob1^.mnolev := topScope^.mnolev; EXIT
  313.             END
  314.         END ;
  315.         obj := ob1
  316.     END Insert;
  317.     PROCEDURE OpenScope*(level: SHORTINT; owner: Object);
  318.         VAR head: Object;
  319.     BEGIN head := NewObj();
  320.         head^.mode := Head; head^.mnolev := level; head^.link := owner;
  321.         IF owner # NIL THEN owner^.scope := head END ;
  322.         head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head
  323.     END OpenScope;
  324.     PROCEDURE CloseScope*;
  325.     BEGIN topScope := topScope^.left
  326.     END CloseScope;
  327.     PROCEDURE InsertImport(obj, root: Object; VAR old: Object);
  328.         VAR ob0, ob1: Object; left: BOOLEAN;
  329.     BEGIN ob0 := root; ob1 := ob0^.right; left := FALSE;
  330.         LOOP
  331.             IF ob1 # NIL THEN
  332.                 IF obj^.name < ob1^.name THEN ob0 := ob1; ob1 := ob1^.left; left := TRUE
  333.                 ELSIF obj^.name > ob1^.name THEN ob0 := ob1; ob1 := ob1^.right; left := FALSE
  334.                 ELSE old := ob1; EXIT
  335.                 END
  336.             ELSE ob1 := obj;
  337.                 IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ;
  338.                 ob1^.left := NIL; ob1^.right := NIL; ob1^.mnolev := root^.mnolev; old := NIL; EXIT
  339.             END
  340.         END
  341.     END InsertImport;
  342.     PROCEDURE ReadId(VAR name: ARRAY OF CHAR; VAR len: LONGINT);
  343.         VAR i: INTEGER; ch: CHAR;
  344.     BEGIN i := 0;
  345.         REPEAT
  346.             OPM.SymRCh(ch); name[i] := ch; INC(i)
  347.         UNTIL ch = 0X;
  348.         len := i
  349.     END ReadId;
  350.     PROCEDURE WriteId(VAR name: ARRAY OF CHAR);
  351.         VAR i: INTEGER; ch: CHAR;
  352.     BEGIN i := 0;
  353.         REPEAT ch := name[i]; OPM.SymWCh(ch); INC(i)
  354.         UNTIL ch = 0X
  355.     END WriteId;
  356.     PROCEDURE Import*(VAR aliasName, impName, selfName: OPS.Name);
  357.         VAR i, m, s, class: INTEGER;
  358.                 k, len: LONGINT; rval: REAL;
  359.                 ch: CHAR; done: BOOLEAN;
  360.                 nofLmod, strno, parlev, fldlev: INTEGER;
  361.                 obj, head, old: Object;
  362.                 typ: Struct;
  363.                 ext: ConstExt;
  364.                 mname: OPS.Name;
  365.                 LocMod:  ARRAY maxImps + 1 OF Object;
  366.                 struct:  ARRAY maxStruct OF Struct;
  367.                 param, lastpar, fldlist, lastfld: ARRAY 6 OF Object;
  368.         PROCEDURE reverseList(p: Object; mnolev: SHORTINT);
  369.             VAR q, r: Object;
  370.         BEGIN q := NIL;
  371.             WHILE p # NIL DO p^.mnolev := mnolev;
  372.                 r := p^.link; p^.link := q; q := p; p := r
  373.             END
  374.         END reverseList;
  375.     BEGIN nofLmod := 0; strno := firstStr;
  376.         parlev := -1; fldlev := -1;
  377.         IF impName = "SYSTEM" THEN SYSimported := TRUE;
  378.             Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink;
  379.             obj^.adr := 0; obj^.typ := notyp
  380.         ELSE OPM.OldSym(impName, FALSE, done);
  381.             IF done THEN
  382.                 struct[Undef] := undftyp; struct[Byte] := bytetyp;
  383.                 struct[Bool] := booltyp;  struct[Char] := chartyp;
  384.                 struct[SInt] := sinttyp;  struct[Int] := inttyp;
  385.                 struct[LInt] := linttyp;  struct[Real] := realtyp;
  386.                 struct[LReal] := lrltyp;  struct[Set] := settyp;
  387.                 struct[String] := stringtyp; struct[NilTyp] := niltyp;
  388.                 struct[NoTyp] := notyp;
  389.                 struct[Pointer] := sysptrtyp;
  390.                 NEW(head); (*for bound procedures*)
  391.                 LOOP (*read next item from symbol file*)
  392.                     OPM.SymRTag(class);
  393.                     IF OPM.eofSF() THEN EXIT END ;
  394.                     IF (class < 8) OR (class = 23) OR (class = 25) THEN (*object*)
  395.                         obj := NewObj(); m := 0;
  396.                         OPM.SymRTag(s); obj^.typ := struct[s];
  397.                         CASE class OF
  398.                            1:
  399.                             obj^.mode := Con; obj^.conval := NewConst();
  400.                             CASE obj^.typ^.form OF
  401.                               Byte, Char:
  402.                                 OPM.SymRCh(ch); obj^.conval^.intval := ORD(ch)
  403.                             | SInt, Bool:
  404.                                 OPM.SymRCh(ch); i := ORD(ch);
  405.                                 IF i > OPM.MaxSInt THEN i := i + 2*OPM.MinSInt END ;
  406.                                 obj^.conval^.intval := i
  407.                             | Int:
  408.                                 OPM.SymRInt(obj^.conval^.intval)
  409.                             | LInt:
  410.                                 OPM.SymRLInt(obj^.conval^.intval)
  411.                             | Set:
  412.                                 OPM.SymRSet(obj^.conval^.setval)
  413.                             | Real:
  414.                                 OPM.SymRReal(rval); obj^.conval^.realval := rval;
  415.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  416.                             | LReal:
  417.                                 OPM.SymRLReal(obj^.conval^.realval);
  418.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  419.                             | String:
  420.                                 obj^.conval^.ext := NewExt();
  421.                                 ReadId(obj^.conval^.ext^, obj^.conval^.intval2);
  422.                                 obj^.conval^.intval := OPM.ConstNotAlloc
  423.                             | NilTyp:
  424.                                 obj^.conval^.intval := OPM.nilval
  425.                             END
  426.                         | 2, 3:
  427.                             obj^.mode := Typ; OPM.SymRTag(m);
  428.                             IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  429.                             IF class = 2 THEN obj^.vis := external ELSE obj^.vis := internal END
  430.                         | 4, 23:
  431.                             obj^.mode := Var;
  432.                             IF OPM.ExpVarAdr THEN OPM.SymRLInt(obj^.adr)
  433.                             ELSE OPM.SymRTag(s); obj^.adr := s
  434.                             END ;
  435.                             IF class = 23 THEN obj^.vis := externalR ELSE obj^.vis := external END
  436.                         | 5, 6, 7, 25:
  437.                             obj^.conval := NewConst();
  438.                             IF class = 5 THEN obj^.mode := IProc; OPM.SymRTag(s); obj^.adr := s
  439.                             ELSIF class = 6 THEN obj^.mode := XProc; OPM.SymRTag(s); obj^.adr := s
  440.                             ELSIF class = 7 THEN  obj^.mode := CProc; ext := NewExt(); obj^.conval^.ext := ext;
  441.                                 OPM.SymRCh(ch); s := ORD(ch); ext^[0] := ch; i := 1; obj^.adr := 0;
  442.                                 WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END
  443.                             ELSE obj^.mode := TProc; obj^.vis := external; OPM.SymRTag(s); typ := struct[s];
  444.                                 OPM.SymRTag(i); OPM.SymRTag(s); obj^.adr := 10000H*i + s
  445.                             END ;
  446.                             obj^.linkadr := OPM.LANotAlloc;    (* link adr *)
  447.                             obj^.conval^.intval := -1;
  448.                             reverseList(lastpar[parlev], LocMod[0]^.mnolev);
  449.                             obj^.link := param[parlev]^.right; DEC(parlev)
  450.                         END ;
  451.                         ReadId(obj^.name, len);
  452.                         IF class = 25 THEN
  453.                             head^.right := typ^.link; head^.mnolev := -typ^.mno; InsertImport(obj, head, old); typ^.link := head^.right
  454.                         ELSE InsertImport(obj, LocMod[m], old)
  455.                         END ;
  456.                         IF (old # NIL) & (obj^.mode = Typ) THEN struct[s] := old^.typ END
  457.                     ELSIF class < 13 THEN (*structure*)
  458.                         typ := NewStr(Undef, Basic); OPM.SymRTag(s); typ^.BaseTyp := struct[s];
  459.                         OPM.SymRTag(s); typ^.mno := -LocMod[s]^.mnolev;
  460.                         CASE class OF
  461.                           8:
  462.                             typ^.form := Pointer; typ^.size := OPM.PointerSize; typ^.n := 0
  463.                         | 9:
  464.                             typ^.form := ProcTyp; typ^.size := OPM.ProcSize; 
  465.                             reverseList(lastpar[parlev], -typ^.mno);
  466.                             typ^.link := param[parlev]^.right; DEC(parlev)
  467.                         | 10:
  468.                             typ^.form := Comp; typ^.comp := Array; OPM.SymRLInt(typ^.size);
  469.                             typ^.n := typ^.size DIV typ^.BaseTyp^.size
  470.                         | 11:
  471.                             typ^.form := Comp; typ^.comp := DynArr;
  472.                             OPM.SymRLInt(typ^.size); OPM.SymRInt(typ^.offset);
  473.                             IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  474.                             ELSE typ^.n := 0
  475.                             END
  476.                         | 12:
  477.                             typ^.form := Comp; typ^.comp := Record;
  478.                             OPM.SymRLInt(typ^.size); typ^.n := 0;
  479.                             reverseList(lastfld[fldlev], -typ^.mno); typ^.link := fldlist[fldlev]^.right; DEC(fldlev);
  480.                             IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL; typ^.extlev := 0
  481.                             ELSE typ^.extlev := typ^.BaseTyp^.extlev + 1
  482.                             END ;
  483.                             OPM.SymRInt(typ^.tdadr)
  484.                         END ;
  485.                         struct[strno] := typ; INC(strno)
  486.                     ELSIF class = 13 THEN (*parameter list start*)
  487.                         obj := NewObj(); obj^.mode := Head; obj^.right := NIL;
  488.                         IF parlev < 5 THEN INC(parlev); param[parlev] := obj; lastpar[parlev] := NIL
  489.                         ELSE err(229)
  490.                         END
  491.                     ELSIF class < 16 THEN (*parameter*)
  492.                         obj := NewObj();
  493.                         IF class = 14 THEN obj^.mode := Var ELSE obj^.mode := VarPar END ;
  494.                         OPM.SymRTag(s); obj^.typ := struct[s];
  495.                         IF OPM.ExpParAdr THEN OPM.SymRLInt(obj^.adr) END ;
  496.                         ReadId(obj^.name, len);
  497.                         obj^.link := lastpar[parlev]; lastpar[parlev] := obj;
  498.                         IF param[parlev]^.right = NIL THEN param[parlev]^.right := obj END
  499.                     ELSIF class = 16 THEN (*start field list*)
  500.                         obj := NewObj(); obj^.mode := Head; obj^.right := NIL;
  501.                         IF fldlev < 5 THEN INC(fldlev); fldlist[fldlev] := obj; lastfld[fldlev] := NIL
  502.                         ELSE err(229)
  503.                         END
  504.                     ELSIF (class = 17) OR (class = 24) THEN (*field*)
  505.                         obj := NewObj(); obj^.mode := Fld; OPM.SymRTag(s);
  506.                         obj^.typ := struct[s]; OPM.SymRLInt(obj^.adr);
  507.                         ReadId(obj^.name, len);
  508.                         obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
  509.                         InsertImport(obj, fldlist[fldlev], old);
  510.                         IF class = 24 THEN obj^.vis := externalR ELSE obj^.vis := external END
  511.                     ELSIF (class = 18) OR (class = 19) THEN (*hidden pointer or proc*)
  512.                         obj := NewObj(); obj^.mode := Fld; OPM.SymRLInt(obj^.adr);
  513.                         IF class = 18 THEN obj^.name := OPM.HdPtrName
  514.                         ELSE obj^.name := OPM.HdProcName
  515.                         END ;
  516.                         obj^.typ := notyp; obj^.vis := internal;
  517.                         obj^.link := lastfld[fldlev]; lastfld[fldlev] := obj;
  518.                         IF fldlist[fldlev]^.right = NIL THEN
  519.                             fldlist[fldlev]^.right := obj
  520.                         END
  521.                     ELSIF class = 20 THEN (*fixup pointer typ*)
  522.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s);
  523.                         IF typ^.BaseTyp = undftyp THEN typ^.BaseTyp := struct[s] END
  524.                     ELSIF class = 21 THEN (*sysflag*)
  525.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s); typ^.sysflag := s
  526.                     ELSIF class = 22 THEN (*module anchor*)
  527.                         OPM.SymRLInt(k); ReadId(mname, len);
  528.                         IF mname = selfName THEN err(154) END ;
  529.                         i := 0;
  530.                         WHILE (i < nofGmod) & (mname # GlbMod[i]^.name) DO
  531.                             INC(i)
  532.                         END ;
  533.                         IF i < nofGmod THEN (*module already present*)
  534.                             IF k # GlbMod[i]^.adr THEN err(150) END ;
  535.                             obj := GlbMod[i]
  536.                         ELSE obj := NewObj();
  537.                             IF nofGmod < maxImps THEN GlbMod[nofGmod] := obj; INC(nofGmod)
  538.                             ELSE err(227)
  539.                             END ;
  540.                             obj^.mode := NotYetExp; COPY(mname, obj^.name);
  541.                             obj^.adr := k; obj^.mnolev := -nofGmod; obj^.right := NIL
  542.                         END ;
  543.                         IF nofLmod < maxImps + 1 THEN LocMod[nofLmod] := obj; INC(nofLmod)
  544.                         ELSE err(227)
  545.                         END
  546.                     ELSIF class = 26 THEN (*nof methods*)
  547.                         OPM.SymRTag(s); typ := struct[s]; OPM.SymRTag(s); typ^.n := s
  548.                     ELSIF class = 27 THEN (*hidden method*)
  549.                         obj := NewObj(); obj^.mode := TProc; obj^.name := OPM.HdTProcName; obj^.typ := undftyp;
  550.                         OPM.SymRTag(s); typ := struct[s]; obj^.mnolev := -typ^.mno;
  551.                         OPM.SymRTag(i); OPM.SymRTag(s); obj^.adr := 10000H*i + s;
  552.                         obj^.linkadr := OPM.LANotAlloc; obj^.vis := internal;
  553.                         obj^.link := NewObj(); obj^.link^.typ := typ; old := typ^.link;
  554.                         IF old = NIL THEN typ^.link := obj
  555.                         ELSE WHILE old^.left # NIL DO old := old^.left END ;
  556.                             old^.left := obj
  557.                         END
  558.                     END
  559.                 END (*LOOP*) ;
  560.                 Insert(aliasName, obj);
  561.                 obj^.mode := Mod; obj^.scope := LocMod[0]^.right;
  562.                 obj^.mnolev  := LocMod[0]^.mnolev; obj^.typ := notyp;
  563.                 OPM.CloseOldSym
  564.             END
  565.         END
  566.     END Import;
  567.     PROCEDURE^ OutStr(typ: Struct);
  568.     PROCEDURE^ OutObjs(obj: Object);
  569.     PROCEDURE ^OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
  570.     PROCEDURE OutPars(par: Object);
  571.     BEGIN
  572.         OPM.SymWTag(13);
  573.         WHILE par # NIL DO
  574.             OutStr(par^.typ);
  575.             IF par^.mode = Var THEN OPM.SymWTag(14) ELSE OPM.SymWTag(15) END ;
  576.             OPM.SymWTag(par^.typ^.ref);
  577.             IF OPM.ExpParAdr THEN OPM.SymWLInt(par^.adr) END ;
  578.             WriteId(par^.name); par := par^.link
  579.         END
  580.     END OutPars;
  581.     PROCEDURE OutHdFld(typ: Struct; fld: Object; adr: LONGINT);
  582.         VAR i, j, n: LONGINT; btyp: Struct;
  583.     BEGIN
  584.         IF typ^.comp = Record THEN OutFlds(typ^.link, adr, FALSE)
  585.         ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n;
  586.             WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ;
  587.             IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
  588.                 j := nofhdfld; OutHdFld(btyp, fld, adr);
  589.                 IF j # nofhdfld THEN i := 1;
  590.                     WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
  591.                         INC(adr, btyp^.size); OutHdFld(btyp, fld, adr); INC(i)
  592.                     END
  593.                 END
  594.             END
  595.         ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN
  596.             OPM.SymWTag(18); OPM.SymWLInt(adr); INC(nofhdfld)
  597.         ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN
  598.             OPM.SymWTag(19); OPM.SymWLInt(adr); INC(nofhdfld)
  599.         END
  600.     END OutHdFld;
  601.     PROCEDURE OutFlds(fld: Object; adr: LONGINT; visible: BOOLEAN);
  602.     BEGIN
  603.         IF visible THEN OPM.SymWTag(16) END ;
  604.         WHILE (fld # NIL) & (fld^.mode = Fld) DO
  605.             IF (fld^.vis # internal) & visible THEN
  606.                 OutStr(fld^.typ);
  607.                 IF fld^.vis = external THEN OPM.SymWTag(17) ELSE OPM.SymWTag(24) END ;
  608.                 OPM.SymWTag(fld^.typ^.ref); OPM.SymWLInt(fld^.adr); WriteId(fld^.name)
  609.             ELSE OutHdFld(fld^.typ, fld, fld^.adr + adr)
  610.             END ;
  611.             fld := fld^.link
  612.         END
  613.     END OutFlds;
  614.     PROCEDURE OutStr(typ: Struct);
  615.         VAR m, em, r: INTEGER; btyp: Struct; mod: Object;
  616.     BEGIN
  617.         IF typ^.ref < 0 THEN OPM.Mark(234, typ^.txtpos)
  618.         ELSIF typ^.ref = 0 THEN
  619.             typ^.ref := -1;
  620.             m := typ^.mno; btyp := typ^.BaseTyp;
  621.             IF m > 0 THEN mod := GlbMod[m-1]; em := mod^.mode;
  622.                 IF em = NotYetExp THEN
  623.                     mod^.mode := nofExp; m := nofExp; INC(nofExp);
  624.                     OPM.SymWTag(22); OPM.SymWLInt(mod^.adr); WriteId(mod^.name)
  625.                 ELSE m := em
  626.                 END
  627.             END ;
  628.             CASE typ^.form OF
  629.               Undef .. NoTyp:
  630.             | Pointer:
  631.                 OPM.SymWTag(8);
  632.                 IF btyp^.ref > 0 THEN OPM.SymWTag(btyp^.ref)
  633.                 ELSE OPM.SymWTag(Undef);
  634.                     IF udpinx < maxUndPtr THEN undPtr[udpinx] := typ; INC(udpinx) ELSE err(224) END
  635.                 END ;
  636.                 OPM.SymWTag(m)
  637.             | ProcTyp:
  638.                 OutStr(btyp); OutPars(typ^.link); OPM.SymWTag(9);
  639.                 OPM.SymWTag(btyp^.ref); OPM.SymWTag(m)
  640.             | Comp:
  641.                 IF typ^.comp = Array THEN
  642.                     OutStr(btyp); OPM.SymWTag(10); OPM.SymWTag(btyp^.ref);
  643.                     OPM.SymWTag(m); OPM.SymWLInt(typ^.size)
  644.                 ELSIF typ^.comp = DynArr THEN
  645.                     OutStr(btyp); OPM.SymWTag(11); OPM.SymWTag(btyp^.ref); OPM.SymWTag(m);
  646.                     OPM.SymWLInt(typ^.size); OPM.SymWInt(typ^.offset)
  647.                 ELSE (* typ^.comp = Record *)
  648.                     IF btyp = NIL THEN r := NoTyp
  649.                     ELSE OutStr(btyp); r := btyp^.ref
  650.                     END ;
  651.                     nofhdfld := 0; OutFlds(typ^.link, 0, TRUE);
  652.                     IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(221, typ^.txtpos) END ;
  653.                     OPM.SymWTag(12); OPM.SymWTag(r); OPM.SymWTag(m);
  654.                     OPM.SymWLInt(typ^.size);
  655.                     OPM.SymWInt(typ^.tdadr)
  656.                 END
  657.             END ;
  658.             IF typ^.sysflag # 0 THEN OPM.SymWTag(21); OPM.SymWTag(strno); OPM.SymWTag(typ^.sysflag) END ;
  659.             IF (typ^.comp = Record) & (typ^.n > 0) THEN
  660.                 OPM.SymWTag(26); OPM.SymWTag(strno); OPM.SymWTag(SHORT(typ^.n))
  661.             END ;
  662.             IF typ^.strobj # NIL THEN
  663.                 IF typ^.strobj^.vis # internal THEN OPM.SymWTag(2) ELSE OPM.SymWTag(3) END ;
  664.                 OPM.SymWTag(strno); OPM.SymWTag(m); WriteId(typ^.strobj^.name)
  665.             END ;
  666.             typ^.ref := strno; INC(strno);
  667.             IF strno > maxStruct THEN err(228) END ;
  668.             IF typ^.comp = Record THEN OutObjs(typ^.link) END (*bound procedures*)
  669.         END
  670.     END OutStr;
  671.     PROCEDURE OutTyps(obj: Object);
  672.         VAR strobj: Object;
  673.     BEGIN
  674.         IF obj # NIL THEN
  675.             OutTyps(obj^.left); 
  676.             IF (obj^.vis # internal) & (obj^.mode = Typ) THEN
  677.                 IF obj^.typ^.ref = 0 THEN OutStr(obj^.typ) END ;
  678.                 strobj := obj^.typ^.strobj;
  679.                 IF (strobj # obj) & (strobj # NIL) THEN
  680.                     OPM.SymWTag(2); OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(0); WriteId(obj^.name)
  681.                 END
  682.             END ;
  683.             OutTyps(obj^.right)
  684.         END
  685.     END OutTyps;
  686.     PROCEDURE OutObjs(obj: Object);
  687.         VAR f, m: INTEGER; rval: REAL; ext: ConstExt; typ: Struct; k: LONGINT;
  688.     BEGIN
  689.         IF obj # NIL THEN
  690.             OutObjs(obj^.left);
  691.             IF (obj^.vis # internal) OR (obj^.mode = TProc) THEN
  692.                 IF obj^.mode = Var THEN
  693.                     OutStr(obj^.typ);
  694.                     IF obj^.vis = externalR THEN OPM.SymWTag(23) ELSE OPM.SymWTag(4) END ;
  695.                     OPM.SymWTag(obj^.typ^.ref);
  696.                     IF OPM.ExpVarAdr THEN OPM.SymWLInt(obj^.adr)
  697.                     ELSE OPM.SymWTag(SHORT(obj^.adr))
  698.                     END ;
  699.                     WriteId(obj^.name)
  700.                 ELSIF obj^.mode = Con THEN
  701.                     OPM.SymWTag(1); f := obj^.typ^.form; OPM.SymWTag(f);
  702.                     CASE f OF
  703.                        Byte, Char:
  704.                         OPM.SymWCh(CHR(obj^.conval^.intval))
  705.                     | Bool, SInt:
  706.                         k := obj^.conval^.intval;
  707.                         IF k < 0 THEN k := k - 2*OPM.MinSInt END ;
  708.                         OPM.SymWCh(CHR(k))
  709.                     | Int:
  710.                         OPM.SymWInt(obj^.conval^.intval)
  711.                     | LInt:
  712.                         OPM.SymWLInt(obj^.conval^.intval)
  713.                     | Set:
  714.                         OPM.SymWSet(obj^.conval^.setval)
  715.                     | Real:
  716.                         rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval)
  717.                     | LReal:
  718.                         OPM.SymWLReal(obj^.conval^.realval)
  719.                     | String:
  720.                         WriteId(obj^.conval^.ext^)
  721.                     | NilTyp:
  722.                     ELSE err(127)
  723.                     END ;
  724.                     WriteId(obj^.name)
  725.                 ELSIF obj^.mode = XProc THEN
  726.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(6);
  727.                     OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(SHORT(obj^.adr)); WriteId(obj^.name)
  728.                 ELSIF obj^.mode = IProc THEN
  729.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(5);
  730.                     OPM.SymWTag(obj^.typ^.ref); OPM.SymWTag(SHORT(obj^.adr)); WriteId(obj^.name)
  731.                 ELSIF obj^.mode = CProc THEN
  732.                     OutStr(obj^.typ); OutPars(obj^.link); OPM.SymWTag(7);
  733.                     OPM.SymWTag(obj^.typ^.ref); ext := obj^.conval^.ext;
  734.                     m := ORD(ext^[0]); f := 1; OPM.SymWCh(CHR(m));
  735.                     WHILE f <= m DO OPM.SymWCh(ext^[f]); INC(f) END ;
  736.                     WriteId(obj^.name)
  737.                 ELSIF obj^.mode = TProc THEN
  738.                     typ := obj^.link^.typ; IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  739.                     IF (typ^.BaseTyp # NIL) & (obj^.adr DIV 10000H < typ^.BaseTyp^.n) & (obj^.vis = internal) THEN
  740.                         OPM.Mark(109, typ^.txtpos)
  741.                         (* hidden and overriding, not detected in OPP because record exported indirectly or via aliasing *)
  742.                     END ;
  743.                     IF OPM.ExpHdTProc OR (obj^.vis # internal) THEN
  744.                         IF obj^.vis # internal THEN OutStr(obj^.typ); OutPars(obj^.link);
  745.                             OPM.SymWTag(25); OPM.SymWTag(obj^.typ^.ref)
  746.                         ELSE OPM.SymWTag(27)
  747.                         END ;
  748.                         OPM.SymWTag(typ^.ref); OPM.SymWTag(SHORT(obj^.adr DIV 10000H));
  749.                         OPM.SymWTag(SHORT(obj^.adr MOD 10000H));
  750.                         IF obj^.vis # internal THEN WriteId(obj^.name) END
  751.                     END
  752.                 END
  753.             END ;
  754.             OutObjs(obj^.right)
  755.         END
  756.     END OutObjs;
  757.     PROCEDURE Export*(VAR modName: OPS.Name; VAR newSF: BOOLEAN; VAR key: LONGINT);
  758.         VAR i: INTEGER; done: BOOLEAN;
  759.             oldkey: LONGINT;
  760.             typ: Struct;
  761.     BEGIN
  762.         OPM.NewSym(modName, done);
  763.         IF done THEN strno := firstStr;
  764.             OPM.SymWTag(22); OPM.SymWLInt(key); WriteId(modName); nofExp := 1;
  765.             OutTyps(topScope^.right); OutObjs(topScope^.right); i := 0;
  766.             WHILE i < udpinx DO
  767.                 typ := undPtr[i]; undPtr[i] := NIL(*garbage collection*); INC(i); OutStr(typ^.BaseTyp);
  768.                 OPM.SymWTag(20); (*fixup*)
  769.                 OPM.SymWTag(typ^.ref); OPM.SymWTag(typ^.BaseTyp^.ref)
  770.             END ;
  771.             IF OPM.noerr THEN
  772.                 OPM.OldSym(modName, TRUE, done);
  773.                 IF done THEN (*compare*)
  774.                     IF OPM.EqualSym(oldkey) THEN OPM.DeleteNewSym; newSF := FALSE; key := oldkey
  775.                     ELSIF newSF THEN OPM.RegisterNewSym(modName)
  776.                     ELSE OPM.DeleteNewSym; err(155)
  777.                     END
  778.                 ELSE OPM.RegisterNewSym(modName); newSF := TRUE
  779.                 END
  780.             ELSE OPM.DeleteNewSym; newSF := FALSE
  781.             END
  782.         ELSE newSF := FALSE
  783.         END
  784.     END Export;
  785.     PROCEDURE InitStruct(VAR typ: Struct; form: SHORTINT);
  786.     BEGIN typ := NewStr(form, Basic); typ^.ref := form; typ^.size := OPM.ByteSize;
  787.         typ^.tdadr := 0; typ^.offset := 0; typ^.strobj := NewObj()
  788.     END InitStruct;
  789.     PROCEDURE EnterBoolConst(name: OPS.Name; value: LONGINT);
  790.         VAR obj: Object;
  791.     BEGIN Insert(name, obj); obj^.conval := NewConst();
  792.         obj^.mode := Con; obj^.typ := booltyp; obj^.conval^.intval := value
  793.     END EnterBoolConst;
  794.     PROCEDURE EnterTyp(name: OPS.Name; form: SHORTINT; size: INTEGER; VAR res: Struct);
  795.         VAR obj: Object; typ: Struct;
  796.     BEGIN Insert(name, obj);
  797.         typ := NewStr(form, Basic); obj^.mode := Typ; obj^.typ := typ; obj^.vis := external;
  798.         typ^.strobj := obj; typ^.size := size; typ^.tdadr := 0; typ^.offset := 0; typ^.ref := form; res := typ
  799.     END EnterTyp;
  800.     PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
  801.         VAR obj: Object;
  802.     BEGIN Insert(name, obj);
  803.         obj^.mode := SProc; obj^.typ := notyp; obj^.adr := num
  804.     END EnterProc;
  805. BEGIN
  806.     topScope := NIL; OpenScope(0, NIL);  OPM.errpos := 0;
  807.     InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
  808.     InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp);
  809.     undftyp^.BaseTyp := undftyp;
  810.     (*initialization of module SYSTEM*)
  811.     EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
  812.     EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
  813.     EnterProc("ADR", adrfn);
  814.     EnterProc("CC", ccfn);
  815.     EnterProc("LSH", lshfn);
  816.     EnterProc("ROT", rotfn);
  817.     EnterProc("GET", getfn);
  818.     EnterProc("PUT", putfn);
  819.     EnterProc("GETREG", getrfn);
  820.     EnterProc("PUTREG", putrfn);
  821.     EnterProc("BIT", bitfn);
  822.     EnterProc("VAL", valfn);
  823.     EnterProc("NEW", sysnewfn);
  824.     EnterProc("MOVE", movefn);
  825.     syslink := topScope^.right;
  826.     universe := topScope; topScope^.right := NIL;
  827.     EnterTyp("CHAR", Char, OPM.CharSize, chartyp);
  828.     EnterTyp("SET", Set, OPM.SetSize, settyp);
  829.     EnterTyp("REAL", Real, OPM.RealSize, realtyp);
  830.     EnterTyp("INTEGER", Int, OPM.IntSize, inttyp);
  831.     EnterTyp("LONGINT",  LInt, OPM.LIntSize, linttyp);
  832.     EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp);
  833.     EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp);
  834.     EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp);
  835.     EnterBoolConst("FALSE", 0);    (* 0 and 1 are compiler internal representation only *)
  836.     EnterBoolConst("TRUE",  1);
  837.     EnterProc("HALT", haltfn);
  838.     EnterProc("NEW", newfn);
  839.     EnterProc("ABS", absfn);
  840.     EnterProc("CAP", capfn);
  841.     EnterProc("ORD", ordfn);
  842.     EnterProc("ENTIER", entierfn);
  843.     EnterProc("ODD", oddfn);
  844.     EnterProc("MIN", minfn);
  845.     EnterProc("MAX", maxfn);
  846.     EnterProc("CHR", chrfn);
  847.     EnterProc("SHORT", shortfn);
  848.     EnterProc("LONG", longfn);
  849.     EnterProc("SIZE", sizefn);
  850.     EnterProc("INC", incfn);
  851.     EnterProc("DEC", decfn);
  852.     EnterProc("INCL", inclfn);
  853.     EnterProc("EXCL", exclfn);
  854.     EnterProc("LEN", lenfn);
  855.     EnterProc("COPY", copyfn);
  856.     EnterProc("ASH", ashfn);
  857.     EnterProc("ASSERT", assertfn) 
  858. END POPT.
  859.